home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / jupmoons.arc / JUPHOUR.PAS < prev   
Pascal/Delphi Source File  |  1985-09-22  |  14KB  |  394 lines
  1.  
  2. program JupiterMoons (input,output);
  3.      {Public Domain                                                }
  4.      {Displays changing positions of Jupitor's 1st 4 moons.        }
  5.      {Works with MONO or Color                                     }
  6.      {Input months as shown ..observe Upper case and lower case    }
  7.      {Use integer days and hours: Universal time                   }
  8.      {Try a period of about 5 days, more is slow to finish         }
  9.      {To show one position, input Start and End times the same     }
  10.      {Good for 1985 only, update first 4 constants for another year}
  11.      {Based on circular orbit approximation                        }
  12.      {Have fun ! Write some public domain astronomy software       }
  13.  
  14. type month = (Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec,
  15.                                                 NotYetAssigned);
  16. var
  17.     StartMonth, EndMonth:month;
  18.     StartDay,EndDay,StartHour,EndHour:integer;
  19.     Days,PhaseDays:real;
  20.  
  21. const
  22.       StartAngleIo = 185 ;          { Ref Data: 00Z  1 Jan 85 }
  23.       StartAngleEuropa = 10;
  24.       StartAngleGanymede = 25 ;
  25.       StartAngleCallisto = 45;
  26.  
  27.  
  28.       LargestOrbit = 1885; {Callisto, 1,885,000 km}
  29.  
  30.       PeriodIo = 1.769;              {Earth days}
  31.       MaxDistIo = 442;               {x 1000 km}
  32.         PeriodEuropa = 3.551;
  33.         MaxDistEuropa = 671;
  34.           PeriodGanymede = 7.155;
  35.           MaxDistGanymede = 1070;
  36.             PeriodCallisto = 16.689;
  37.             MaxDistCallisto = 1885;
  38.  
  39.       ScreenOffset = 40;
  40.       zeroize = 0;
  41.  
  42.       YIo =14; YEuropa = 15; YGanymede = 18; YCallisto =19;
  43.       ExIo = 1; ExEuropa = 23; ExGanymede = 44; ExCallisto =66;
  44.       YJupitor   = 17;
  45.       XJupitor   = 40;
  46.       Io = '·';         { ASCII 250 }
  47.       Europa = '·';     {   "   250 }
  48.       Ganymede = '∙';   {   "   249 }
  49.       Callisto = '∙';   {   "   249 }
  50.       Jupitor = '(_)';
  51.  
  52.       IoName = 'I'; EuropaName = 'E'; GanymedeName = 'G';
  53.       CallistoName = 'C';
  54.  
  55.  
  56.       FirstMonthOfYear = Jan;
  57.       FirstDayOfYear = 1;
  58.       FirstHourOfYear = 0;
  59.  
  60. var ScalingFactor: real;
  61.     DaysDisplayed: real;
  62.     TimeIncrement: real;
  63.     Time: real;
  64.     AngleIo,AngleEuropa,AngleGanymede,AngleCallisto: real;
  65.     AngleChangeIo,AngleChangeEuropa,AngleChangeGanymede: real;
  66.     AngleChangeCallisto: real;
  67.     PositionIo,PositionEuropa,PositionGanymede,
  68.                                     PositionCallisto: integer;
  69.     OldPositionIo,OldPositionEuropa,OldPositionGanymede,
  70.                                   OldPositionCallisto:integer;
  71.  
  72.     DistanceIo,DistanceEuropa,DistanceGanymede,DistanceCallisto
  73.                                                          :real;
  74.  
  75.  
  76. procedure cursor(Top,Bottom:integer);
  77.  
  78.        { Sets size of cursor:   top line    =  0
  79.                                 bottom line = 13
  80.               if Top < Bottom then normal cursor.
  81.               if Top > Bottom then 2-part cursor.
  82.               if Top = Bottom then thinnest cursor.
  83.               if Top = Bottom = 14 then no cursor.
  84.               if Top and/or Bottom > 14 or < 0 then ????. }
  85.  
  86.   var Ctop,Cbottom:integer;
  87.  
  88.   begin
  89.     Ctop := Top; Cbottom := Bottom;
  90.     if (Ctop<0) or (Ctop>14) then Ctop := 12;
  91.     if (Cbottom<0) or (Cbottom>14) then Cbottom := 13;
  92.  
  93.     inline
  94.             { Interrupts BIOS for cursor size
  95.                  INT 10H with AH = 01H
  96.                  CH = top of cursor, bits 0-4
  97.                  CL = bottom of cursor, bits 0-4
  98.                  CH,CL   bits 5-7 should be 0.   }
  99.  
  100.      ($50/                   { PUSH AX                       }
  101.       $51/                   { PUSH CX                       }
  102.       $8B/$86/CTOP/          { MOV AX,SS:[BP]+OFFSET CTOP    }
  103.       $8A/$E8/               { MOV CH,AL                     }
  104.       $8B/$86/CBOTTOM/       { MOV AX,SS:[BP]+OFFSET CBOTTOM }
  105.       $8A/$C8/               { MOV CL,AL                     }
  106.       $B4/$01/               { MOV AH,O1H                    }
  107.       $FB/                   { STI                           }
  108.       $CD/$10/               { INT 10H                       }
  109.       $59/                   { POP CX                        }
  110.       $58);                  { POP AX                        }
  111.  
  112.  
  113.   end; {cursor}
  114.  
  115.  
  116. procedure ExactPositions(ExMoon:integer;DistanceMoon:real);
  117.      begin
  118.         GoToXY(ExMoon,24); write('    ');
  119.         GoToXY(ExMoon,24); write(DistanceMoon:5:0,',000 KM')
  120.      end;  {ExactPositions}
  121.  
  122.  
  123. procedure LocateMoon(AngleMoon:real;MaxDistMoon:real;
  124.               var DistanceMoon:real; var PositionMoon:integer);
  125.  
  126.      var RadianMoon: real;
  127.  
  128.      begin
  129.         RadianMoon := AngleMoon * (Pi/180);
  130.         DistanceMoon := MaxDistMoon * sin(RadianMoon);
  131.         PositionMoon := round(DistanceMoon/ScalingFactor)
  132.                                                 + ScreenOffset
  133.      end;   {LocateMoon}
  134.  
  135. procedure EraseMoon(DeletePositionMoon,YMoon:integer);
  136.  
  137.      begin
  138.         GoToXY(DeletePositionMoon,YMoon);
  139.         write(' ');
  140.         GoToXY(DeletePositionMoon,YJupitor);
  141.         write(' ')
  142.      end;  {EraseMoon}
  143.  
  144.  
  145. procedure PlotMoon (var OldPositionMoon:integer;PositionMoon:integer;
  146.                              Moon:char; YMoon:integer;MoonName:char);
  147.  
  148.      begin
  149.         GoToXY(PositionMoon,YMoon);
  150.         write(MoonName);
  151.         GoToXY(PositionMoon,YJupitor);
  152.         write (Moon);
  153.  
  154.         OldPositionMoon := PositionMoon
  155.  
  156.      end;   {PlotMoon}
  157.  
  158. procedure GetDate(var GetMonth:month;var GetDay,GetHour:integer);
  159.  
  160.      type reply = string[3];
  161.  
  162.      const Blank = -1;  {for dummy variables}
  163.  
  164.      var WhatMonth: reply;
  165.          MaxDays: integer;
  166.      begin
  167.         while GetMonth = NotYetAssigned
  168.           do begin
  169.               GoToXY(25,8); write('What month, Jan..Dec ?       ');
  170.               GoToXY(50,8); read(WhatMonth);
  171.                 if WhatMonth = 'Jan' then GetMonth := Jan;
  172.                 if WhatMonth = 'Feb' then Getmonth := Feb;
  173.                 if WhatMonth = 'Mar' then Getmonth := Mar;
  174.                 if WhatMonth = 'Apr' then Getmonth := Apr;
  175.                 if WhatMonth = 'May' then GetMonth := May;
  176.                 if Whatmonth = 'Jun' then GetMonth := Jun;
  177.                 if WhatMonth = 'Jul' then GetMonth := Jul;
  178.                 if WhatMonth = 'Aug' then GetMonth := Aug;
  179.                 if WhatMonth = 'Sep' then GetMonth := Sep;
  180.                 if WhatMonth = 'Oct' then GetMonth := Oct;
  181.                 if WhatMonth = 'Nov' then GetMonth := Nov;
  182.                 if WhatMonth = 'Dec' then Getmonth := Dec
  183.               end; {while}
  184.          case GetMonth of
  185.            Jan,Mar,May,Jul,Aug,Oct,Dec: MaxDays := 31;
  186.            Sep,Apr,Jun,Nov: MaxDays := 30;
  187.            Feb: MaxDays := 29
  188.          end; {case}
  189.  
  190.       GetDay := Blank;
  191.          while not (GetDay in [1..MaxDays]) do
  192.             begin
  193.                GoToXY(25,10);write('What day, 1..',MaxDays,' ?     ');
  194.                GoToXY(45,10);read(GetDay)
  195.             end; {while}
  196.  
  197.       GetHour := Blank;
  198.          while not (GetHour in [0..23]) do
  199.             begin
  200.                GoToXY(25,12);write('What hour, 0..23 ?       ');
  201.                GoToXY(45,12);read(GetHour)
  202.             end; {while}
  203.          delay(1000);
  204.          GoToXY(25,8); clrEOL;
  205.          GoToXY(25,10); clrEOL;
  206.          GoToXY(25,12); clrEOL
  207.      end;  {GetDate}
  208.  
  209. procedure StartAndEnd;
  210.      var EndAfterStart:boolean;
  211.      begin
  212.        EndAfterStart := False;
  213.        while not EndAfterStart
  214.           do begin
  215.  
  216.               StartMonth := NotYetAssigned;
  217.               GoToXY(30,6);write('STARTING DATE/TIME');
  218.               GetDate(StartMonth,StartDay,StartHour);
  219.               GoToXY(30,6); clrEOL;
  220.  
  221.             EndMonth := NotYetAssigned;
  222.             GoToXY(30,6);write('END DATE/TIME');
  223.             GetDate(EndMonth,EndDay,EndHour);
  224.             GoToXY(30,6); clrEOL;
  225.  
  226.  
  227.            if
  228.                  (EndMonth < StartMonth)
  229.               or ((EndMonth = StartMonth) and (EndDay < StartDay))
  230.               or ((EndMonth = StartMonth) and (EndDay = StartDay)
  231.                                           and (EndHour < StartHour))
  232.            then begin
  233.                   GoToXY(25,8);write('We can''t END before BEGIN');
  234.                   delay(5000)
  235.                 end {then}
  236.  
  237.            else EndAfterStart := true
  238.  
  239.        end {while}
  240.      end;  {StartAndEnd}
  241.  
  242.  
  243.   function DaysInMonth(FirstMonth:month):integer;
  244.  
  245.      begin
  246.          case FirstMonth of
  247.                 Jan,Mar,May,Jul,Aug,Oct,Dec:DaysInMonth := 31;
  248.                 Sep,Apr,Jun,Nov:DaysInMonth := 30;
  249.                 Feb:DaysInMonth := 28
  250.               end  {case}
  251.      end;  {DaysInMonth}
  252.  
  253. procedure DaysBetweenDates(var TotalDays:real;FirstMonth,SecondMonth
  254.            :month;FirstDay,SecondDay,FirstHour,SecondHour:integer);
  255.  
  256.    var MaxDaysFirst:integer;
  257.  
  258.    begin
  259.       if FirstHour <= SecondHour
  260.       then TotalDays := TotalDays + (SecondHour - FirstHour)/24
  261.       else TotalDays := TotalDays -1+(24 - FirstHour + SecondHour)/24;
  262.  
  263.       if FirstDay <= SecondDay
  264.       then TotalDays := TotalDays + (SecondDay - FirstDay)
  265.       else begin
  266.            MaxDaysFirst := DaysInMonth(FirstMonth);
  267.            TotalDays := TotalDays + MaxDaysFirst - FirstDay+SecondDay;
  268.            SecondMonth := pred(SecondMonth)
  269.            end; {else}
  270.  
  271.       while FirstMonth < SecondMonth
  272.         do begin
  273.            TotalDays := TotalDays + DaysInMonth(FirstMonth);
  274.            FirstMonth := succ(FirstMonth)
  275.            end  {while}
  276.      end;  {DaysBetweenDates}
  277.  
  278. procedure GetStartAngles;
  279.  
  280.        begin
  281.         AngleIo := AngleIo +(360/PeriodIo*PhaseDays);
  282.         AngleEuropa := AngleEuropa +(360/PeriodEuropa*PhaseDays);
  283.         AngleGanymede := AngleGanymede+(360/PeriodGanymede*PhaseDays);
  284.         AngleCallisto := AngleCallisto+(360/PeriodCallisto*PhaseDays);
  285.  
  286.      while AngleIo >= 360 do AngleIo := AngleIo-360;
  287.      while AngleEuropa >= 360 do AngleEuropa := AngleEuropa-360;
  288.      while AngleGanymede >= 360 do AngleGanymede := AngleGanymede-360;
  289.      while AngleCallisto >= 360 do AngleCallisto := AngleCallisto-360
  290.  
  291.         end;  {GetStartAngles}
  292.  
  293. begin  {******************** MAIN *********************}
  294.  
  295.       cursor(14,14);
  296.  
  297.       ScalingFactor := LargestOrbit / (ScreenOffset-1);
  298.  
  299.       AngleIo := StartAngleIo;
  300.       AngleEuropa := StartAngleEuropa;
  301.       AngleGanymede := StartAngleGanymede;
  302.       AngleCallisto := StartAngleCallisto;
  303.  
  304.       OldPositionIo := XJupitor;         {DummyPositions}
  305.       OldPositionEuropa := XJupitor;
  306.       OldPositionGanymede := XJupitor;
  307.       OldPositionCallisto := XJupitor;
  308.  
  309.       Time := Zeroize;
  310.  
  311.       TimeIncrement := 1/12;
  312.       ClrScr;
  313.  
  314.       StartAndEnd; {Get Dates}
  315.  
  316.       Days := 0;
  317.       DaysBetweenDates(Days,StartMonth,EndMonth,StartDay,EndDay,
  318.                        StartHour,EndHour);
  319.  
  320.       DaysDisplayed := Days;
  321.  
  322.       PhaseDays := 0;
  323.       DaysBetweenDates(PhaseDays,FirstMonthOfYear,StartMonth,
  324.                        FirstDayOfYear,StartDay,FirstHourOfYear
  325.                        ,StartHour);
  326.       GetStartAngles;
  327.       ClrScr;
  328.       GoToXY(XJupitor,YJupitor-1);    {Draw Jupitor}
  329.       write('_');
  330.       GoToXY(XJupitor-1,YJupitor);
  331.       write (Jupitor);
  332.  
  333.       GoToXY(30,3); write('Satellites of Jupitor');
  334.  
  335.       {GoToXY(70,3);write(Days:3:0);}  {To Print, remove braces}
  336.       {GoToXY(70,5);write(PhaseDays);}
  337.  
  338.       GoToXY(ExIo,23);         write('   I = Io');
  339.       GoToXY(ExEuropa,23);     write('  E = Europa');
  340.       GoToXY(ExGanymede,23);   write('G = Ganymede');
  341.       GoToXY(ExCallisto,23);   write('C = Callisto');
  342.  
  343.       AngleChangeIo := (360/PeriodIo)*(TimeIncrement);
  344.       AngleChangeEuropa := (360/PeriodEuropa)*(TimeIncrement);
  345.       AngleChangeGanymede := (360/PeriodGanymede)*(TimeIncrement);
  346.       AngleChangeCallisto := (360/PeriodCallisto)*(TimeIncrement);
  347.  
  348.       while Time <= DaysDisplayed
  349.          do begin
  350.  
  351.             LocateMoon(AngleIo,MaxDistIo,DistanceIo,PositionIo);
  352.             LocateMoon(AngleEuropa,MaxDistEuropa,DistanceEuropa,
  353.                                                        PositionEuropa);
  354.             LocateMoon(AngleGanymede,MaxDistGanymede,DistanceGanymede,
  355.                                                      PositionGanymede);
  356.             LocateMoon(AngleCallisto,MaxDistCallisto,DistanceCallisto,
  357.                                                      PositionCallisto);
  358.  
  359.                EraseMoon(OldPositionIo,YIo);
  360.                EraseMoon(OldPositionEuropa,YEuropa);
  361.                EraseMoon(OldPositionGanymede,YGanymede);
  362.                EraseMoon(OldPositionCallisto,YCallisto);
  363.  
  364.             PlotMoon(OldPositionIo,PositionIo,Io,YIo,IoName);
  365.             PlotMoon(OldPositionEuropa,PositionEuropa,Europa,YEuropa,
  366.                                                           EuropaName);
  367.             PlotMoon(OldPositionGanymede,PositionGanymede,Ganymede,
  368.                                               YGanymede,GanymedeName);
  369.             PlotMoon(OldPositionCallisto,PositionCallisto,Callisto,
  370.                                               YCallisto,CallistoName);
  371.                ExactPositions(ExIo,DistanceIo);
  372.                ExactPositions(ExEuropa,DistanceEuropa);
  373.                ExactPositions(ExGanymede,DistanceGanymede);
  374.                ExactPositions(ExCallisto,DistanceCallisto);
  375.  
  376.                GoToXY(XJupitor-1,YJupitor);
  377.                write(Jupitor);
  378.                GoToXY(1,1);  {Get cursor away from Callisto}
  379.  
  380.                AngleIo := AngleIo + AngleChangeIo;
  381.                AngleEuropa := AngleEuropa + AngleChangeEuropa;
  382.                AngleGanymede := AngleGanymede + AngleChangeGanymede;
  383.                AngleCallisto := AngleCallisto + AngleChangeCallisto;
  384.  
  385.                Time := Time + TimeIncrement;
  386.                if KeyPressed then Time := DaysDisplayed+1; {Escape !}
  387.  
  388.             end;   {while}
  389.             cursor(12,13)
  390.  
  391. end.  {******************** MAIN **********************}
  392.  
  393.  
  394.